home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8301.arc / DATEDEMO.PAS next >
Pascal/Delphi Source File  |  1986-09-14  |  3KB  |  110 lines
  1. PROGRAM DATEDEMO(INPUT,OUTPUT);
  2.  
  3. CONST
  4.    SLASH = '/';
  5.    BASE_YEAR = 80;
  6.  
  7. TYPE
  8.    DATE_TYPE = STRING(8);
  9.  
  10. VAR
  11.    REQ_DATE:DATE_TYPE;
  12.    PACKED_VALUE:WORD;
  13.  
  14. PROCEDURE PACK_DATE(DATE_STRING:DATE_TYPE;
  15.                     VAR DATE_WORD:WORD);
  16.  
  17. VAR
  18.    START_POSITION:INTEGER;
  19.    SLASH_POSITION:INTEGER;
  20.    TEMP_WORD:WORD;
  21.    TEMP_STRING:LSTRING(2);
  22.    SUCCESS:BOOLEAN;
  23.  
  24. BEGIN   {PACK_DATE}
  25.  
  26.    DATE_WORD := 0;
  27.    START_POSITION := 1;
  28.    SLASH_POSITION := POSITN(SLASH,DATE_STRING,START_POSITION);
  29.    MOVEL(ADR DATE_STRING[START_POSITION],ADR TEMP_STRING[1],WRD(SLASH_POSITION - START_POSITION));
  30.    TEMP_STRING.LEN := LOBYTE(SLASH_POSITION - START_POSITION);
  31.    SUCCESS := DECODE(TEMP_STRING,TEMP_WORD);
  32.    DATE_WORD := DATE_WORD + (TEMP_WORD * 32);
  33.  
  34.    START_POSITION := SLASH_POSITION + 1;
  35.    TEMP_WORD := 0;
  36.    SLASH_POSITION := POSITN(SLASH,DATE_STRING,START_POSITION);
  37.    MOVEL(ADR DATE_STRING[START_POSITION],ADR TEMP_STRING[1],WRD(SLASH_POSITION - START_POSITION));
  38.    TEMP_STRING.LEN := LOBYTE(SLASH_POSITION - START_POSITION);
  39.    SUCCESS := DECODE(TEMP_STRING,TEMP_WORD);
  40.    DATE_WORD := DATE_WORD + TEMP_WORD;
  41.  
  42.    START_POSITION := SLASH_POSITION + 1;
  43.    TEMP_WORD := 0;
  44.    MOVEL(ADR DATE_STRING[START_POSITION],ADR TEMP_STRING[1],2);
  45.    TEMP_STRING.LEN := 2;
  46.    SUCCESS := DECODE(TEMP_STRING,TEMP_WORD);
  47.    IF TEMP_WORD < BASE_YEAR
  48.       THEN DATE_WORD := DATE_WORD + (((100 - BASE_YEAR) + TEMP_WORD) * 512)
  49.       ELSE DATE_WORD := DATE_WORD + ((TEMP_WORD - BASE_YEAR) * 512);
  50.  
  51. END;   {PACK_DATE}
  52.  
  53.  
  54. PROCEDURE UNPACK_DATE(VAR DATE_STRING:DATE_TYPE;
  55.                       DATE_WORD:WORD);
  56.  
  57. VAR
  58.    TEMP_WORD:WORD;
  59.    TEMP_STRING:LSTRING(2);
  60.    SUCCESS:BOOLEAN;
  61.  
  62. BEGIN   {UNPACK_DATE}
  63.  
  64.    DATE_STRING := '        ';
  65.  
  66.    TEMP_WORD := (DATE_WORD AND 16#01E0) DIV 32;
  67.    SUCCESS := ENCODE(TEMP_STRING,TEMP_WORD:2);
  68.    MOVEL(ADR TEMP_STRING[1],ADR DATE_STRING[1],2);
  69.    DATE_STRING[3] := SLASH;
  70.  
  71.    TEMP_WORD := (DATE_WORD AND 16#001F);
  72.    SUCCESS := ENCODE(TEMP_STRING,TEMP_WORD:2);
  73.    IF TEMP_STRING[1] = ' ' THEN TEMP_STRING[1] := '0';
  74.    MOVEL(ADR TEMP_STRING[1],ADR DATE_STRING[4],2);
  75.    DATE_STRING[6] := SLASH;
  76.  
  77.    TEMP_WORD := ((DATE_WORD AND 16#FE00) DIV 512);
  78.    IF TEMP_WORD < (100 - BASE_YEAR)
  79.       THEN TEMP_WORD := TEMP_WORD + BASE_YEAR
  80.       ELSE TEMP_WORD := TEMP_WORD + BASE_YEAR - 100;
  81.    SUCCESS := ENCODE(TEMP_STRING,TEMP_WORD:2);
  82.    IF TEMP_STRING[1] = ' ' THEN TEMP_STRING[1] := '0';
  83.    MOVEL(ADR TEMP_STRING[1],ADR DATE_STRING[7],2);
  84.  
  85. END;   {UNPACK_DATE}
  86.  
  87.  
  88. BEGIN   {DATEDEMO}
  89.  
  90.    REPEAT
  91.       PACKED_VALUE := 0;
  92.       WRITE(OUTPUT,'Enter the date [MM/DD/YY]: ');
  93.       READLN(INPUT,REQ_DATE);
  94.       IF REQ_DATE = 'END     ' THEN CYCLE;
  95.       
  96.       PACK_DATE(REQ_DATE,PACKED_VALUE);
  97.       WRITELN(OUTPUT,' ');
  98.       WRITELN(OUTPUT,'   The packed value for ',REQ_DATE,' IS ',PACKED_VALUE);
  99.       WRITELN(OUTPUT,' ');
  100.       REQ_DATE := '        ';
  101.       UNPACK_DATE(REQ_DATE,PACKED_VALUE);
  102.       WRITELN(OUTPUT,'   The unpacked string for ',PACKED_VALUE,' IS ',REQ_DATE);
  103.       WRITELN(OUTPUT,' ');
  104.       WRITELN(OUTPUT,'-------------------------');
  105.    UNTIL REQ_DATE = 'END     ';
  106.  
  107.    WRITELN(OUTPUT,' ');
  108.    WRITELN(OUTPUT,'End of DATEDEMO program');
  109. END.   {DATEDEMO}
  110.